home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happysrc / pcetc.c < prev    next >
Text File  |  1994-11-14  |  15KB  |  366 lines
  1. /**********************************************************************
  2.  *
  3.  *              ***   HAPPy Pascal compiler ***
  4.  *                    各種サブルーチン群
  5.  *
  6.  *      void skip(Set fsys)
  7.  *      void updatelc(int upsize)
  8.  *      void getbounds(stp *fsp,long *fmin, long *fmax)
  9.  *      boolean equalbounds(stp *fsp1, stp *fsp2)
  10.  *      int align(stp *fsp,int flc)
  11.  *      void conststrings(stp **fsp, union valu *fvalu)
  12.  *      void constant(Set fsys, stp **fsp, union valu *fvalu)
  13.  *      boolean compatible(stp *fsp1,stp *fsp2)
  14.  *      boolean assigncompati(stp *fsp1,stp *fsp2)
  15.  *      boolean string(stp *fsp)
  16.  *
  17.  *                Copyright (c) H.Asano 1992,1994.
  18.  *
  19.  **********************************************************************/
  20.  
  21. #define EXTERN extern
  22. #include <string.h>
  23. #include "pascomp.h"
  24.  
  25. typedef enum _sign {none, pos, neg } signflag ;
  26.  
  27. boolean string(stp*) ;
  28. extern void pcerr(int,char*) ;
  29. extern void insymbol(void) ;
  30. extern ctp  *searchid(Set) ;
  31. extern Set  *mkset(Set*,int,...) ;
  32. extern Set  *orset(Set*,Set*)    ;
  33. extern void term(void) ;
  34. extern void *Malloc(int) ;
  35. extern void applied(ctp*,int) ;
  36.  
  37. /**************************************/
  38. /* skip() : 誤り回復のためにsymbolを  */
  39. /*          キーにして読み飛ばす      */
  40. /**************************************/
  41. void skip(Set fsys)
  42. {
  43.      while(! inset(fsys,sy))
  44.       insymbol() ;
  45. }
  46.  
  47. /**************************************/
  48. /* updatelc() : location counter更新  */
  49. /**************************************/
  50. void updatelc(int upsize)
  51. {
  52.        if(Maxaddr-upsize < lc)
  53.         pcerr(609,"") ;                 /* 変数割当できない           */
  54.        else lc += upsize ;              /* lc を更新                  */
  55. }
  56.  
  57. /*******************************************************/
  58. /* getbounds() : 範囲型,文字型,整数型､集合型,列挙型の  */
  59. /*               下限､上限値を求める                   */
  60. /*  (* assume fsp<>intptr and fsp<>realptr *)          */
  61. /*******************************************************/
  62. void getbounds(stp *fsp,long *fmin, long *fmax)
  63. {
  64.      if(!fsp) return ;
  65.  
  66.      if(fsp == charptr) {               /* 文字型                     */
  67.       *fmin = ordminchar          ;     /*   一番小さい文字コード     */
  68.       *fmax = ordmaxchar          ;     /*   一番大きい文字コード     */
  69.      }
  70.      else if(fsp == intptr) {           /* 整数型                     */
  71.       *fmin = -Maxint ;                 /*   -Maxint .. Maxint        */
  72.       *fmax =  Maxint ;
  73.      }
  74.      else if(fsp->form == subrange) {   /* 範囲型                     */
  75.       *fmin = fsp->sf.su.min      ;     /*  下限                      */
  76.       *fmax = fsp->sf.su.max      ;     /*  上限                      */
  77.      }
  78.      else if(fsp->form == power) {      /* 集合型                     */
  79.       *fmin = fsp->sf.pw.elmin   ;      /* 下限                       */
  80.       *fmax = fsp->sf.pw.elmax   ;      /* 上限                       */
  81.      }
  82.      else if(fsp->sf.sc.fconst) {       /* 列挙型の時                 */
  83.       *fmax = fsp->sf.sc.fconst->n.values.ival ; /* 最後の列挙名の値  */
  84.       *fmin = 0 ;
  85.      }
  86. }
  87.  
  88. /****************************************/
  89. /* equalbounds() : 2つの型の上限､下限が */
  90. /*                 等しいか判定する     */
  91. /****************************************/
  92. boolean equalbounds(stp *fsp1, stp *fsp2)
  93. {
  94.   long lmin1,lmin2,lmax1,lmax2 ;
  95.  
  96.      if((!fsp1) || (!fsp2)) return(true) ;  /* 今のところ意味不明     */
  97.  
  98.      getbounds(fsp1,&lmin1,&lmax1) ;    /* fsp1 の下限､上限を調べる   */
  99.      getbounds(fsp2,&lmin2,&lmax2) ;    /* fsp2 の下限､上限を調べる   */
  100.      return((lmin1==lmin2) && (lmax1==lmax2)) ;/* 両方とも等しいとき真*/
  101. }
  102.  
  103. /**************************************/
  104. /* alignquot() : 型の境界を求める     */
  105. /*     align の 内部関数              */
  106. /**************************************/
  107. static int alignquot(stp *fsp)
  108. {
  109.      if(!fsp) return(1) ;               /* 型ポインタがない時は1      */
  110.  
  111.      switch(fsp->form) {
  112.       case scalar   :                   /* スカラー型    */
  113.              if(fsp==intptr)  return(intal)  ;           /* integer型     */
  114.              if(fsp==boolptr) return(boolal) ;           /* boolean型     */
  115.              if(fsp==charptr) return(charal) ;           /* char   型     */
  116.              if(fsp==realptr) return(realal) ;           /* real   型     */
  117.              if(fsp->sf.sc.scalkind == declared)         /* 列挙   型     */
  118.                               return(intal)  ;
  119.              return(parmal) ;                            /* parameter list*/
  120.       case subrange :                   /* 範囲型        */
  121.              return(alignquot(fsp->sf.su.rangetype)) ;   /* 範囲の元の型  */
  122.       case pointer  :                   /* ポインタ型    */
  123.              return(adral)  ;
  124.       case power    :                   /* 集合型        */
  125.              return(setal)  ;
  126.       case files    :                   /* ファイル型    */
  127.              return(fileal) ;
  128.       case arrays   :                   /* 配列型        */
  129.              return(alignquot(fsp->sf.ar.aeltype)) ;
  130.                                         /* 要素の型      */
  131.       case records  :                   /* レコード      */
  132.              return(recal)  ;
  133. /*    case variant  : */                /* 可変レコード  */
  134. /*    case tagfld   : */                /* 可変レコードのタグ名 */
  135.                                         /* このルートはない     */
  136.      }
  137. }
  138.  
  139. /************************************************/
  140. /* align() : 型に応じた割りつけ開始番地を求める */
  141. /*            flc    : 今の番地                 */
  142. /*            return : 割りつけ開始番地         */
  143. /************************************************/
  144. int align(stp *fsp,int flc)
  145. {
  146.   int k, l;
  147.  
  148.      k = alignquot(fsp) ;               /* その型の境界値を求める     */
  149.      l = flc - 1 + k    ;               /* flc以上の最小のkの公倍数を */
  150.      return(l - l%k)    ;               /* 返却する                   */
  151. }
  152.  
  153. /***************************************/
  154. /* constident():  名前定数の処理       */
  155. /***************************************/
  156. static void constident(signflag fsign,stp **fsp, union valu *fvalu)
  157. {
  158.   stp *lsp ;
  159.   ctp *lcp ;
  160.   csp *lvp ;
  161.   Set ws ;
  162.  
  163.      mkset(&ws, konst, -1)   ;
  164.      lcp = searchid(ws)      ;          /* 定数の名前から探す         */
  165.      applied(lcp,level)      ;          /* 参照名チェーン             */
  166.      lsp = lcp->idtype       ;
  167.      *fvalu = lcp->n.values  ;          /* 名前の値                   */
  168.      if(fsign != none) {                /* 符号がある時               */
  169.       if(lsp == intptr) {               /*  整数                      */
  170.        if(fsign == neg)
  171.         (*fvalu).ival = -(*fvalu).ival; /*  値を反転                  */
  172.       }
  173.       else if(lsp == realptr) {         /*  実数                      */
  174.        if(fsign == neg) {
  175.         lvp = (csp*)Malloc(sizeof(csp));
  176.         lvp->cclass = real ;
  177.         lvp->c.rval = (char*)Malloc(Maxdiglng+1+1);
  178.         *(lvp->c.rval) = ((*(*fvalu).valp->c.rval)=='-')/*  - * - = + */
  179.                           ? (char)' ' : (char)'-'  ;    /*  + * - = - */
  180.         strcpy(lvp->c.rval+1,
  181.               (*fvalu).valp->c.rval+1); /*  中身を移しかえ            */
  182.         (*fvalu).valp = lvp ;
  183.        }
  184.       }
  185.       else   pcerr(105,lcp->name) ;     /*  整数や実数でないのに      */
  186.                                         /*  符号があるので、符号は駄目*/
  187.                                         /*  のエラーメッセージ        */
  188.      }
  189.      *fsp   = lsp ;
  190.      insymbol()   ;
  191. }
  192.  
  193. /***************************************/
  194. /* conststrings():  文字列定数の処理   */
  195. /***************************************/
  196. void conststrings(stp **fsp, union valu *fvalu)
  197. {
  198.   stp *lsp,*lsp1 ;
  199.  
  200.      if(lgth == 1)      lsp = charptr ; /*   1文字は文字型            */
  201.      else if(lgth == 0) lsp = nil ;     /*   0文字はエラー            */
  202.      else {
  203.       lsp = (stp*)Malloc(sizeof(stp));
  204.       lsp->size = lgth*charsize ;       /* 文字列長                   */
  205.       lsp->form = arrays ;              /* 配列型                     */
  206.       lsp->sf.ar.packed  = true    ;    /* 詰め込み型である           */
  207.       lsp->sf.ar.aeltype = charptr ;    /*  要素の型は文字型          */
  208.       lsp1 = (stp*)Malloc(sizeof(stp)) ;/*  添字の型は                */
  209.       lsp1->form = subrange          ;  /*        範囲型              */
  210.       lsp1->size = intsize           ;
  211.       lsp1->sf.su.rangetype = intptr ;
  212.       lsp1->sf.su.min = 1            ;  /*  添字の下限値は1           */
  213.       lsp1->sf.su.max = (long)lgth   ;  /*  添字の上限値は文字列長    */
  214.       lsp->sf.ar.inxtype = lsp1      ;  /*  添字の型をこの範囲型とする*/
  215.      }
  216.      *fvalu = val ;                     /*  文字列を返却              */
  217.      *fsp   = lsp ;
  218. }
  219.  
  220. /*********************************************/
  221. /*     constant() : 定数の処理               */
  222. /*********************************************/
  223. void constant(Set fsys, stp **fsp, union valu *fvalu)
  224. {
  225.   stp *lsp ;
  226.   signflag sign ;
  227.   Set ws ;
  228.  
  229.      lsp = nil ;
  230.      (*fvalu).ival = 0 ;
  231.  
  232.      if(! inset(constbegsys,sy)) {    /* 定数として許されない時  */
  233.       pcerr(50,"") ;                  /*  定数に誤りがある       */
  234.       ws = fsys                 ;
  235.       orset(&ws,&constbegsys)   ;
  236.       skip(ws)                  ;     /* fsys+constbegsysまでskip*/
  237.      }
  238.  
  239.      if(inset(constbegsys,sy)) {      /* 定数としてOKの時        */
  240.       if(sy == stringconst) {         /*   文字列定数の時        */
  241.        conststrings(fsp,fvalu)  ;     /*   文字列定数の処理      */
  242.        insymbol()               ;
  243.       }
  244.       else {
  245.      /***  文字列以外の時は まず符号(+ -)の処理をする ***/
  246.  
  247.        sign = none ;
  248.        if((op == plus) || (op == minus)) {  /* + - の 時          */
  249.         sign = (op == plus) ? pos : neg ;   /*  符号の選別        */
  250.         insymbol() ;
  251.        }
  252.  
  253.        if(sy == ident)                  /* 名前の時                   */
  254.         constident(sign,fsp,fvalu) ;    /* 名前定数の処理             */
  255.  
  256.        else if(sy == intconst) {        /* 整数定数の時               */
  257.  
  258.         if(sign == neg) val.ival = -val.ival ; /* -の時は値を反転 */
  259.         *fsp   = intptr     ;
  260.         *fvalu = val        ;
  261.         insymbol()          ;
  262.        }
  263.  
  264.        else if(sy == realconst) {       /* 実数定数の時               */
  265.         if(sign == neg)
  266.         *(val.valp->c.rval) = '-' ;     /*  頭に負の符号をつける      */
  267.         *fsp = realptr      ;
  268.         *fvalu = val        ;
  269.         insymbol()          ;
  270.        }
  271.  
  272.        else {                           /* それ以外                   */
  273.         pcerr(106,"") ;                 /* 数がない                   */
  274.         skip(fsys)    ;
  275.        }
  276.       }
  277.      }
  278.  
  279.      if(! inset(fsys,sy)) {
  280.       pcerr(6,"") ;                     /* 不当な記号が現れた */
  281.       skip(fsys)  ;
  282.      }
  283. }
  284.  
  285. /********************************************/
  286. /* compatible() : 2つの型が適合するか判定   */
  287. /********************************************/
  288. boolean compatible(stp *fsp1,stp *fsp2)
  289. {
  290.  
  291.      if(fsp1 == fsp2) return(true) ;    /* 型のアドレスが同じなら等しい*/
  292.  
  293.      if((!fsp1) || (!fsp2)) return(true);
  294.                                         /* どちらかがnilならば､すでに
  295.                                           エラーメッセージが出ている
  296.                                           はずなので、ここでさらに
  297.                                           エラーを検出させないためtrue*/
  298.  
  299.      if(fsp1->form == fsp2->form)       /* 型が等しい                 */
  300.       switch(fsp1->form) {
  301.        case subrange : return           /* 部分範囲型                 */
  302.                       (fsp1->sf.su.rangetype == fsp2->sf.su.rangetype);
  303.                                         /*   両方が 同じ型            */
  304.  
  305.        case power    :                  /* 集合型                     */
  306.                       if((fsp1->sf.pw.packed == both) ||
  307.                          (fsp2->sf.pw.packed == both))
  308.                         return(compatible(fsp1->sf.pw.elset, /*基底の型*/
  309.                                           fsp2->sf.pw.elset )) ;/*のD適合*/
  310.                       else return
  311.                       (!(fsp1->sf.pw.packed ^ fsp2->sf.pw.packed) &&
  312.                                         /* 両方とも詰めなしか詰めあり */
  313.                        compatible(fsp1->sf.pw.elset,     /* 基底の型が*/
  314.                                   fsp2->sf.pw.elset )) ; /* 適合      */
  315.  
  316.        case pointer :  return           /* ポインタ型                 */
  317.                       ((fsp1 == nilptr) || (fsp2 == nilptr)) ;
  318.                                         /*   nilは全てのﾎﾟｲﾝﾀ型と適合 */
  319.  
  320.        case arrays  :  return           /* 配列型                     */
  321.                       (string(fsp1) && string(fsp2) &&
  322.                         (fsp1->sf.ar.inxtype->sf.su.max ==
  323.                          fsp2->sf.ar.inxtype->sf.su.max));
  324.                                          /* 同数の成分を持つ文字列型の
  325.                                             時は適合する              */
  326.  
  327.        default       : return(false)  ; /* それ以外の型は不適合       */
  328.       }
  329.  
  330.      else if(fsp1->form == subrange)    /* fsp1がfsp2の部分範囲か     */
  331.       return (fsp1->sf.su.rangetype == fsp2) ;
  332.      else if(fsp2->form == subrange)    /* fsp2がfsp1の部分範囲か     */
  333.       return (fsp1 == fsp2->sf.su.rangetype) ;
  334.      else return(false) ;
  335. }
  336.  
  337. /***************************************************/
  338. /* assigncompati() : 2つの型の代入可能性を判定する */
  339. /*           型fsp1に対して型fsp2が代入可能の時真  */
  340. /***************************************************/
  341. boolean assigncompati(stp *fsp1,stp *fsp2)
  342. {
  343.      if(fsp1 == fsp2)                   /* 同じ型                     */
  344.       return(fsp1->assignflag) ;        /* 代入可能性のチェック       */
  345.      else if((fsp1 == realptr) && compatible(fsp2,intptr)) return(true) ;
  346.      else return(compatible(fsp1,fsp2)) ;
  347. }
  348.  
  349. /**************************************/
  350. /* string() : 型が文字列か判定する    */
  351. /**************************************/
  352. boolean string(stp *fsp)
  353. {
  354.      if(!fsp) return(false) ;
  355.  
  356.      return
  357.         ((fsp->form == arrays)                       /* 配列型         */
  358.      && (fsp->sf.ar.packed)                         /* packed指定あり */
  359.      && (compatible(fsp->sf.ar.aeltype,charptr))    /* 要素の型が文字型*/
  360.      && (fsp->sf.ar.inxtype->form == subrange)      /* 添字の型は範囲 */
  361.      && (fsp->sf.ar.inxtype->sf.su.min == 1)        /* 下限値は1      */
  362.      && (fsp->sf.ar.inxtype->sf.su.max >  1 )) ;    /* 上限値は2以上  */
  363.                                         /* その時 文字列と認められる  */
  364.                                         /* 上記以外は文字列ではない   */
  365. }
  366.